;;(load "ut.scm")
(define (run/err2lisp1 car-key l)
  `(let ((r ,l))
     (if (eq? (car r) ',car-key)
	 (exit r)
	 r)))
(define (r/err2lisp1 car-key l)
  `(let ((r1 ,l))
     (if (eq? r1 ',car-key)
	 (exit r1)
	 r1)))
(define (err2lisp1 car-key l)
  `(let ((r ,l))
     (cond
      ((atom? r)
       (if (eq? r ',car-key)
	   (exit r)
	   r))
      ((pair? r)
       (if (eq? (car r) ',car-key)
	   (exit r)
	   r)))))
(define (run/err2lisp car-key l fn)
  (let ((--exit (string->symbol (format "exit-~a" fn))))
  `(let ((r ,l))
     (if (eq? (car r) ',car-key)
	 (,--exit r)
	 r))))
(define (r/err2lisp car-key l fn)
  (let ((--exit (string->symbol (format "exit-~a" fn))))
  `(let ((r1 ,l))
     (if (eq? r1 ',car-key)
	 (,--exit r1)
	 r1))))
(define (err2lisp car-key l fn)
  (let ((--exit (string->symbol (format "exit-~a" fn))))
  `(let ((r ,l))
     (cond
      ((atom? r)
       (if (eq? r ',car-key)
	   (,--exit r)
	   r))
      ((pair? r)
       (if (eq? (car r) ',car-key)
	   (,--exit r)
	   r))))))
      
;;run/err function must return a list. it's first element is 'err if a error occurs.
(define-macro (run/err fn . par) `(,fn ,@par))
;;r/err function must return a value return. it's first element is 'err if a error occurs.
(define-macro (r/err fn . par) `(,fn ,@par))

(define (lisp-find car-key l)
  (cond
   ((eq? car-key 'r/err)
    (lisp-find/tr car-key 'err l r/err2lisp))
   ((eq? car-key 'run/err)
    (lisp-find/tr car-key 'err l run/err2lisp))
   ((and (pair? car-key)(equal? car-key '(run/err r/err)))
    (let ((res-car-key 'err)(key-handle (list run/err2lisp r/err2lisp)))
      (lisp-find/tr-in-list car-key res-car-key l key-handle)))
   ((and (pair? car-key)(equal? car-key '(r/err run/err)))
    (let ((res-car-key 'err)(key-handle (list r/err2lisp run/err2lisp)))
      (lisp-find/tr-in-list car-key res-car-key l key-handle)))
   (else (format "错误提示:[~a]处理方法未定义。 " car-key))))
(define (lisp-find/tr car-key res-car-key l key-handle fn)
  (cond
   ((null? l) '())
   ((atom? l) l)
   ((and (pair? l)(pair? (car l)))
    (cons (lisp-find/tr car-key res-car-key (car l) key-handle fn)
	  (lisp-find/tr car-key res-car-key (cdr l) key-handle fn)))
   ((and (pair? l)(atom? (car l))(eq? (car l) car-key))
    (set! l (lisp-find/tr car-key res-car-key (cdr l) key-handle fn))
    (key-handle res-car-key l fn))
   ((and (pair? l)(atom? (car l))(not (eq? (car l) car-key)))
    (cons (car l) (lisp-find/tr car-key res-car-key (cdr l) key-handle fn)))
   (else (format  "错误提示:[~a]非法到达，开发错误。 " l))))
(define (lisp-find/tr-in-list car-key res-car-key l key-handle)
  (cond
   ((null? l) '())
   ((atom? l) l)
   ((and (pair? l)(pair? (car l)))
    (cons (lisp-find/tr-in-list car-key res-car-key (car l) key-handle)
	  (lisp-find/tr-in-list car-key res-car-key (cdr l) key-handle)))
   ((and (pair? l)(atom? (car l)))
    (let ((pos (position (car l) car-key)))
      (if (integer? pos)
	  ((list-ref key-handle pos) res-car-key l)
	  (cons (car l) (lisp-find/tr-in-list car-key res-car-key (cdr l) key-handle)))))
   (else (format  "错误提示:[~a]非法到达，开发错误。 " l))))
(define-macro (def/e fn-l . body)
  (let ((newbody (lisp-find '(run/err r/err) body)))
    `(define ,fn-l
       (call/cc (lambda (exit) ,@newbody)))))
(define-macro (def/el fn-l . body)
  (let ((newbody (lisp-find 'run/err body)))
    `(define ,fn-l
       (call/cc (lambda (exit) ,@newbody)))))
(define-macro (def/e1 fn-l . body)
  (let ((newbody (lisp-find 'r/err body)))
    `(define ,fn-l
       (call/cc (lambda (exit) ,@newbody)))))
(define-macro (def/err fn-l . body)
  (let ((newbody (lisp-find/tr 'run/err 'err body err2lisp (car fn-l)))
	(exit-label (string->symbol (format "exit-~a" (car fn-l))))
	)
    `(define ,fn-l
       (call/cc (lambda (,exit-label) ,@newbody)))))
(define-macro (def/err1 fn-l . body)
  (let ((newbody (lisp-find/tr 'run/err 'err body err2lisp))
	)
    `(define ,fn-l
       (call/cc (lambda (exit) ,@newbody)))))
(define-macro (define-macro/err fn-l . body)
  (if (and (pair? fn-l)(>= (length fn-l) 2))
      (let ((newbody (lisp-find/tr 'run/err 'err body err2lisp (cadr fn-l)))
	    (new-fn-l (append (list (car fn-l)) (nth-cdr 2 fn-l)))
	    )
	`(define-macro ,new-fn-l
	   ,@newbody))
  (display "PANIC:define-macro/err macro has too few parameters[~a],should big than 2." (length fn-l))))
(define-macro (let-set1! v fun)
  `(let ((r ,fun))
    (let f ((l ,v)(r r))
      (if (pair? l) 
	  (begin
	    (set-car! l (car r))
	    (set! l (cdr l))
	    (if (pair? r) (set! r (cdr r)) '())
	    (f l r) )))))

(define-syntax let-set!
  (syntax-rules ()
    ((_ (e) f)
     (let ((r f))
       (if (pair? r) (set! e (car r)) (set! e r))))
    ((_ (e1 e2 ...) f)
     (let ((r f))
       (if (pair? r)
	   (begin
	     (set! e1 (car r))
	     (let-set! (e2 ...) (cdr r)))
	   (begin
	     (set! e1 r)
	     (let-set! (e2 ...) '())))))))
	   
	 
;;these are tests for verify the def/err def/el def/e1 function as below.
;;(define (p1 a) (if (> a 0) a 'err))
;;(define (p2 a b) (if (> a 0) (list a (+ a b)) '(err "a<0 illegal.")))
;;(define (ppp a b)
;;  (cond
;;   ((> a 0) (+ (car (run/err p2 b a)) a))
;;   ((= a 0) 0)
;;   ((< a 0) (+ (r/err p1 b) a))))
;;(def/err (pppll a b)
;;  (cond
;;   ((> a 0) (+ (car (run/err p2 b a)) a))
;;   ((= a 0) 0)
;;   ((< a 0) (+ (r/err p1 b) a))))
;;(def/el (pppl a b)
;;  (cond
;;   ((> a 0) (run/err p2 b a) a)
;;   ((= a 0) 0)
;;   ((< a 0) b)))
;;(def/e1 (ppp1 a b)
;;  (cond
;;   ((> a 0) a)
;;   ((= a 0) 0)
;;   ((< a 0) (r/err p1 b) b)))
;;(ppp 2 3)==>5
;;(ppp 2 -3)==>illegal
;;(ppp -2 3)==>1
;;(ppp -2 -3)==>illegal

;;(pppll 2 3)==>5
;;(pppll 2 -3)==>'(err "a<0 illegal")
;;(pppll -2 3)==>1
;;(pppll -2 -3)==>'err

;;(pppl 2 3)==>5
;;(pppl 2 -3)==>'(err "a<0 illegal")

;;(ppp1 -2 3)==>1
;;(ppp1 -2 -3)==>'err
;;def/err函数支持返回为列表和单值的函数。如果是列表，则其第一个元素表示返回结果出错与否，返回'err表示出错。返回其他则是可接受返回值。如果是单值，则使用'err代表出错，其他值表示允许值。任何需要调用以这种规则返回的函数需要逐级返回到最顶级并进行错误处理的情况，在调用函数时区分列表返回（使用run/err调用）、单值返回（使用r/err调用）。
;;在顶级调用位置需要使用错误处理函数进行错误处理。


(define-macro (def/ret fn-l . body)
  (let ((exit-label (string->symbol (format "exit-~a" (car fn-l)))))
  `(define ,fn-l (call/cc (lambda (,exit-label) ,@body)))))
(define-macro (return-from fn res)
  (let ((exit-label (string->symbol (format "exit-~a" fn))))
  `(,exit-label ,res)))
(define-macro (define-macro/ret fn-l . body)
  (if (and (pair? fn-l)(>= (length fn-l) 2))
      (let ((new-fn-l (append (list (car fn-l)) (nth-cdr 2 fn-l)))
	    (exit-label (string->symbol (format "exit-~a" (nth 1 fn-l))))
	    )
	`(define-macro ,new-fn-l
	   (call/cc (lambda (,exit-label)
	   ,@body))))
      (display "PANIC:define-macro/err macro has too few parameters[~a],should big than 2." (length fn-l))))
(define-macro (def/rest fn a b)
  (let ((new-fn (string->symbol (format "~a、..." fn)))
	(s (gensym))
	(i (gensym))
	(e (gensym))
	)
    `(define (,new-fn ,a . ,b)
       (let ((,s  (,fn ,a (car ,b))))
	 (tr-list (,i ,e ,b 1)
		  (set! ,s (,fn ,s ,e)))
	 ,s))))
(define-macro (def/scm-rest fn  a)
  (let ((new-fn (string->symbol (format "【*】~a、..." fn)))
	)
    `(define (,new-fn . ,a)
      (apply ,fn ,a))))
		
